perm filename PAKTST.OLD[M11,LCS] blob sn#406213 filedate 1978-12-28 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		DIMENSION INP(80)
C00004 ENDMK
CāŠ—;
	DIMENSION INP(80)
	DATA IBLA/' '/,ISEMI/';'/
888	FORMAT(80A1)
889	FORMAT(1XA5)
890	FORMAT(' TYPE'/)
891	FORMAT(1X80A1)
5	TYPE 890
	ACCEPT 888,INP
	DO 1 J=1,80
1	IF(INP(J).EQ.IBLA.OR.INP(J).EQ.ISEMI)GO TO 2
2	JJ=J
	J=J-1
	N=J
	IF(J.GT.5)N=4
	DO 3 M=80,1,-1
3	IF(INP(M).NE.IBLA)GO TO 4
	GO TO 5
4	CALL PACKER(NN,INP,N)
C NN BRINGS BACK PACKED NAME, INP IS ARRAY, N IS WDCNT.
	TYPE 889,NN
70	DO 7 I=1,M-JJ
7	INP(I)=INP(I+JJ)
	DO 8 I=M-J,M
8	INP(I)=IBLA
	M=M-JJ
	TYPE 891,(INP(K),K=1,M)
	END

	SUBROUTINE PACKER(NN,JNM,N)
	DIMENSION JNM(1),KNM(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	DATA MM/"774000000000/,IBLA/' '/

	DO 10 K=1,5
	IF(K.GT.N)GO TO 11
	KNM(K)=JNM(K)
	GO TO 10
11	KNM(K)=IBLA
10	CONTINUE
C N=WDCNT OF INST NAME
	NN=0
	DO 12 K=5,1,-1
	NN=NN .OR. (KNM(K) .AND. MM)
	IF (K.EQ.1)RETURN
17	IF (NN.GE.0)GO TO 13
	NN = (( NN .AND. LL)/KK) .OR. JJ
	GO TO 12
13	NN = NN / KK
12	CONTINUE
	END